home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Tools & Apps / Graphics & Imaging / Printer Drivers / STD File Saver 1.1 / MyPDEF_0_DraftMode.p < prev    next >
Encoding:
Text File  |  1991-06-06  |  31.0 KB  |  873 lines  |  [TEXT/MPS ]
  1. {
  2. Description of the PrintX array:
  3.     1            used as Enum                value 0 corresponding to A4 format                        (style Dlg)
  4.                                                 value 1 corresponding to US format                        (style Dlg)
  5.                                                 value 2 corresponding to Custom format                    (style Dlg)
  6.     2            used as Integer            Reduce/Enlarge ratio                                            (style Dlg)
  7.     3            used as Integer            Horizontal value for Custom format                        (style Dlg)
  8.     4            used as Integer            Vertical value for Custom format                            (style Dlg)
  9.     5            used as Enum                value 0 corresponding to MilliInches unit                (style Dlg)
  10.                                                 value 1 corresponding to MilliMeters unit                (style Dlg)
  11.                                                 value 2 corresponding to Pixel unit                        (style Dlg)
  12.     6            used as Boolean            value 0 corresponding to Portrait Orientation        (style Dlg)
  13.                                                 value 1 corresponding to LandScape Orientation        (style Dlg)
  14.     7            used as Boolean            value 0 corresponding to All pages                        (job Dlg)
  15.                                                 value 1 corresponding to pages From … To …            (job Dlg)
  16.     8            used as Boolean            value 0 corresponding to TEXT saving                    (job Dlg)
  17.                                                 value 1 corresponding to PICT saving                    (job Dlg)
  18.     9            used as Integer            signature $5345 "ES"
  19.     10,11        used as OsType                creator used for TEXT saving                                (option Dlg)
  20.     12,13        used as OsType                creator used for PICT saving                                (option Dlg)
  21.     14            used as Boolean            value 0 corresponding to Color                            (job Dlg)
  22.                                                 value 1 corresponding to Black & White                    (job Dlg)
  23.     15,16        used as Longint            scaling ratio                                                    (option Dlg)
  24.     17            used as Boolean            value 0 corresponding to PicComment saving            (option Dlg)
  25.                                                 value 1 corresponding to PicComment ignoring            (option Dlg)
  26.     18            not used
  27.     19            not used
  28. }
  29.  
  30. unit MyPDEF_0_DraftMode;
  31.  
  32. interface
  33.  
  34. uses MemTypes, QuickDraw, OsIntf, ToolIntf, PackIntf, MacPrint;
  35.  
  36. {$D+}
  37. {$R-}
  38. {$OV-}
  39.  
  40. type
  41.     MyPrintRec    =    RECORD
  42.                             dirName: Str255;
  43.                             dirID: Longint;
  44.                             dirVol: Integer;
  45.                             fileName: Str255;
  46.                             fileRef: Integer;
  47.                             textOrPict: Boolean;
  48.                             OtherPort: GrafPtr;
  49.                             thePict: PicHandle;
  50.                             CurPage: Integer;
  51.                             cProcs: CQDProcs;
  52.                             theTextType,
  53.                             thePictType: OsType;
  54.                             scaleRatio: Longint;
  55.                         END;
  56.     MyPrintPtr    = ^MyPrintRec;
  57.  
  58. function DraftPrOpenDoc(hPrint: THPrint; pPrPort: TPPrPort; pIOBuf: Ptr): TPPrPort;
  59. procedure DraftPrCloseDoc(pPrPort: TPPrPort);
  60. procedure DraftPrOpenPage(pPrPort: TPPrPort; pPageFrame: TPRect);
  61. procedure DraftPrClosePage(pPrPort: TPPrPort);
  62. procedure DraftPrText(byteCount: Integer; textBuf: Ptr; numer, denom: Point);
  63. procedure DraftPrLine(newPt: Point);
  64. procedure DraftPrRect(verb: GrafVerb; r: Rect);
  65. procedure DraftPrrRect(verb: GrafVerb; r: Rect; ovalWidth, ovalHeight: Integer);
  66. procedure DraftPrOval(verb: GrafVerb; r: Rect);
  67. procedure DraftPrArc(verb: GrafVerb; r: Rect; startAngle, arcAngle: Integer);
  68. procedure DraftPrPoly(verb: GrafVerb; Poly: PolyHandle);
  69. procedure DraftPrRgn(verb: GrafVerb; Rgn: RgnHandle);
  70. procedure DraftPrBits(var srcBits: BitMap; var srcRect, dstRect: Rect; mode: Integer; maskRgn: RgnHandle);
  71. procedure DraftPrComment(kind, dataSize: Integer; dataHandle: Handle);
  72. procedure ChangeBottleNeck(withColor: Boolean; myPPrPort: TPPrPort; thePrintPtr: MyPrintPtr; withPicComments: Boolean);
  73. function GetValues(hPrint: THPrint; thePrintPtr: MyPrintPtr): Boolean;
  74. function GetVolumeRef(theWDRefNum: Integer; VAR theVolRef: Integer; VAR theDirID: Longint): OsErr;
  75. function CreateDirectory(VAR fName: Str63; theVRefNum: Integer; theDirID: Longint; VAR theNewDirID: Longint): OsErr;
  76. function OpenWorkingDirectory(theVolRef: Integer; theDirID: Longint; VAR theWDRefNum: Integer): OsErr;
  77. function AskUser(thePrintPtr: MyPrintPtr): OsErr;
  78. procedure ModifyScalePort(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point);
  79. procedure ModifyScalePoint(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR thePoint: Point);
  80. procedure GetNewPenLoc(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR thePoint: Point);
  81. procedure ModifyScaleRect(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR theRect: Rect);
  82. procedure ModifyScalerRect(scaleRatio: Longint; VAR ovalWidth, ovalHeight: Integer);
  83. procedure ModifyScalePoly(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR thePoly: PolyHandle);
  84. procedure ModifyScaleRgn(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR theRgn: RgnHandle);
  85. function AdjustToInteger(theLong: Longint): Integer;
  86.  
  87. implementation
  88.  
  89. const
  90.     PrintErr= $944;
  91.  
  92. type
  93.     IntPtr= ^Integer;
  94.     
  95. function DraftPrOpenDoc(hPrint: THPrint; pPrPort: TPPrPort; pIOBuf: Ptr): TPPrPort;
  96. { here we do some allocations, get some init values and most important: modify the bottleneck }
  97. var
  98.     myPPrPort: TPPrPort;
  99.     CodeErr: Integer;
  100.     theWorld: SysEnvRec;
  101.     withPicComments: Boolean;
  102.  
  103.     procedure BugOut(theErr: Integer);
  104.     { if something goes wrong, we must try to dispose as many blocks as we can }
  105.     { before returning the error code }
  106.         begin
  107.             if myPPrPort <> nil then
  108.                 begin
  109.                     if myPPrPort^.lGParam4 <> 0 then
  110.                         begin
  111.                             if not (hPrint^^.printX[8] = 0) then
  112.                                 DisposPtr(Ptr(MyPrintPtr(myPPrPort^.lGParam4)^.OtherPort));
  113.                             DisposPtr(Ptr(myPPrPort^.lGParam4));
  114.                             if myPPrPort^.gPort.portBits.rowBytes < 0
  115.                                 then CloseCPort(CGrafPtr(myPPrPort))
  116.                                 else ClosePort(GrafPtr(myPPrPort));
  117.                         end;
  118.                     if myPPrPort^.fOurPtr then DisposPtr(Ptr(myPPrPort));
  119.                 end;
  120.             IntPtr(PrintErr)^ := theErr;
  121.             DraftPrOpenDoc := myPPrPort;
  122.             exit(DraftPrOpenDoc);
  123.         end;
  124.  
  125.     begin
  126.         DraftPrOpenDoc := nil;
  127.         if pPrPort = nil then { does the caller give us a Printing Port or do we allocate it ? }
  128.             begin
  129.                 myPPrPort := TPPrPort(NewPtr(sizeof(TPrPort)));
  130.                 if myPPrPort = nil then BugOut(iMemFullErr);
  131.                 myPPrPort^.fOurPtr := true;
  132.             end
  133.         else
  134.             begin
  135.                 myPPrPort := pPrPort;
  136.                 myPPrPort^.fOurPtr := false;
  137.             end;
  138.         myPPrPort^.lGParam4 := Longint(NewPtr(sizeof(MyPrintRec))); { we need this space to work }
  139.         if myPPrPort^.lGParam4 = 0 then BugOut(iMemFullErr);
  140.  
  141.         withPicComments := (hPrint^^.printX[17] = 0);
  142.         CodeErr := SysEnvirons(1, theWorld);
  143.         
  144.         { the real job is here, changing the QuickDraw Bottleneck to install our printing routines }
  145.         ChangeBottleNeck(theWorld.hasColorQD and (hPrint^^.printX[14] = 0), myPPrPort, MyPrintPtr(myPPrPort^.lGParam4), withPicComments);
  146.  
  147.         { to prevent any real drawing, set the bounds to EmptyRect }
  148.         if myPPrPort^.gPort.portBits.rowBytes < 0
  149.             then SetRect(CGrafPtr(myPPrPort)^.portPixMap^^.bounds, 0, 0, 0, 0)
  150.             else SetRect(myPPrPort^.gPort.portBits.bounds, 0, 0, 0, 0);
  151.         myPPrPort^.gPort.portRect := hPrint^^.prInfo.rPage;
  152.         
  153.         if not GetValues(hPrint, MyPrintPtr(myPPrPort^.lGParam4)) then BugOut(iMemFullErr);
  154.         
  155.         { if PICT saving, create another grafport to construct the picture }
  156.         { this other port will get the same fields as the Printing Port except for the 4 last fields }
  157.         { which are really private to each port }
  158.         if not (hPrint^^.printX[8] = 0) then
  159.             begin
  160.                 MyPrintPtr(myPPrPort^.lGParam4)^.OtherPort := GrafPtr(NewPtr(sizeof(GrafPort)));
  161.                 if MyPrintPtr(myPPrPort^.lGParam4)^.OtherPort = nil then BugOut(iMemFullErr);
  162.                 BlockMove(Ptr(myPPrPort), Ptr(MyPrintPtr(myPPrPort^.lGParam4)^.OtherPort), sizeof(GrafPort)-16);
  163.             end;
  164.         
  165.         { we ask the user where he wants to store the printing, in a file if it's TEXT saving, }
  166.         { in a folder if it's PICT saving }
  167.         CodeErr := AskUser(MyPrintPtr(myPPrPort^.lGParam4));
  168.         if CodeErr <> noErr then BugOut(CodeErr);
  169.         
  170.         DraftPrOpenDoc := myPPrPort;
  171.     end;
  172.  
  173. procedure DraftPrCloseDoc(pPrPort: TPPrPort);
  174. { pretty simple: we close everything, dispose what needs to, and that's all folks }
  175. var
  176.     CodeErr: Integer;
  177.     theWDBlock: WDPBRec;
  178.     
  179.     begin
  180.         if pPrPort <> nil then
  181.             begin
  182.                 if pPrPort^.lGParam4 <> 0 then
  183.                     begin
  184.                         if not MyPrintPtr(pPrPort^.lGParam4)^.textOrPict then
  185.                             begin
  186.                                 if MyPrintPtr(pPrPort^.lGParam4)^.thePictType = 'RSED' then    { • New ! v.1.1 • }
  187.                                     CloseResFile(MyPrintPtr(pPrPort^.lGParam4)^.fileRef);
  188.                                 DisposPtr(Ptr(MyPrintPtr(pPrPort^.lGParam4)^.OtherPort));
  189.                                 with theWDBlock do
  190.                                     begin
  191.                                         ioCompletion := nil;
  192.                                         ioVRefNum := MyPrintPtr(pPrPort^.lGParam4)^.dirVol;
  193.                                         CodeErr := PBCloseWD(@theWDBlock, false);
  194.                                         if CodeErr <> noErr then
  195.                                             {*** This should never happen so I don't know what to do ***};
  196.                                     end;
  197.                             end
  198.                         else CodeErr := FSClose(MyPrintPtr(pPrPort^.lGParam4)^.fileRef);
  199.                         DisposPtr(Ptr(pPrPort^.lGParam4));
  200.                     end
  201.                 else;
  202.                 if pPrPort^.gPort.portBits.rowBytes < 0
  203.                     then CloseCPort(CGrafPtr(pPrPort))
  204.                     else ClosePort(GrafPtr(pPrPort));
  205.                 DisposPtr(Ptr(pPrPort));
  206.             end
  207.         else;
  208.     end;
  209.  
  210. procedure DraftPrOpenPage(pPrPort: TPPrPort; pPageFrame: TPRect);
  211. { in case of PICT saving, we create a new PICT file for each page }
  212. { the name of the PICT file is the name chosen by the user + the number of the page }
  213. { and we store that file in the folder with the same name that we created in DraftPrOpenDoc }
  214. var
  215.     i, CodeErr: Integer;
  216.     val, theCount: Longint;
  217.     nStr: Str255;
  218.  
  219.     begin
  220.         with MyPrintPtr(pPrPort^.lGParam4)^ do if not textOrPict then
  221.             begin
  222.                 CurPage := CurPage + 1;
  223.                 if thePictType <> 'RSED' then                                        { • New ! v.1.1 • }
  224.                     begin
  225.                         { let's get the file }
  226.                         fileName := dirName;
  227.                         if Length(fileName) > 22 then fileName[0] := Chr(22);
  228.                         NumToString(CurPage, nStr);
  229.                         while Length(nStr) < 4 do nStr := Concat('0', nStr);
  230.                         if Length(nStr) = 4 then nStr := Concat(' ', nStr);
  231.                         fileName := Concat(fileName, nStr);
  232.                         CodeErr := Create(fileName, dirVol, thePictType, 'PICT');
  233.                         CodeErr := FSOpen(fileName, dirVol, fileRef);
  234.                         { as always, a PICT file begins with 512 bytes that we can set to 0 }
  235.                         theCount := 4;
  236.                         val := 0;
  237.                         for i := 1 to 128 do CodeErr := FSWrite(fileRef, theCount, @val);
  238.                     end;
  239.                 { let's reinitialize the picture saving grafport and open the picture for saving }
  240.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  241.                 with OtherPort^ do
  242.                     begin
  243.                         picSave := nil; rgnSave := nil; polySave := nil; grafProcs := nil;
  244.                         SetPort(OtherPort);
  245.                         ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  246.                         thePict := OpenPicture(portRect);
  247.                         if thePict = nil then
  248.                             begin
  249.                                 IntPtr(PrintErr)^ := iMemFullErr;
  250.                                 exit(DraftPrOpenPage);
  251.                             end;
  252.                         ClipRect(portRect);
  253.                     end;
  254.             end;
  255.         SetPort(GrafPtr(pPrPort));
  256.     end;
  257.  
  258. procedure DraftPrClosePage(pPrPort: TPPrPort);
  259. { in case of PICT saving, we close the picture and save it in the file that we close just after }
  260. { we also save the current color table as a 'clut' resource in the same file since a lot of }
  261. { Color Paint or Draw software use that kind of information to get the colors right }
  262. { in case of TEXT saving, we just insert an ASCII code 12 meaning Form Feed in the TEXT file }
  263. var
  264.     CodeErr: Integer;
  265.     theCount: Longint;
  266.     aHandle: Handle;
  267.     aVol: Integer;
  268.  
  269.     begin
  270.         with MyPrintPtr(pPrPort^.lGParam4)^ do if not textOrPict then
  271.             begin
  272.                 SetPort(OtherPort);
  273.                 ClosePicture;
  274.                 SetPort(GrafPtr(pPrPort));
  275.                 theCount := GetHandleSize(Handle(thePict));
  276.                 if thePictType = 'RSED' then            { • New ! v.1.1 • }
  277.                     begin
  278.                         aVol := CurResFile;
  279.                         UseResFile(fileRef);
  280.                         AddResource(Handle(thePict), 'PICT', CurPage, '');
  281.                         WriteResource(Handle(thePict));
  282.                         UpdateResFile(fileRef);
  283.                         UseResFile(aVol);
  284.                     end
  285.                 else
  286.                     begin
  287.                         CodeErr := FSWrite(fileRef, theCount, Ptr(thePict^));
  288.                         CodeErr := FSClose(fileRef);
  289.                         if pPrPort^.gPort.portBits.rowBytes < 0 then
  290.                             begin
  291.                                 CodeErr := GetVol(nil, aVol);
  292.                                 CodeErr := SetVol(nil, dirVol);
  293.                                 CreateResFile(fileName);
  294.                                 fileRef := OpenResFile(fileName);
  295.                                 if fileRef = -1 then exit(DraftPrClosePage);
  296.                                 theCount := GetHandleSize(Handle(CGrafPtr(pPrPort)^.portPixMap^^.pmTable));
  297.                                 aHandle := NewHandle(theCount);
  298.                                 if aHandle = nil then exit(DraftPrClosePage);
  299.                                 BlockMove(Ptr(CGrafPtr(pPrPort)^.portPixMap^^.pmTable^), aHandle^, theCount);
  300.                                 AddResource(aHandle, 'clut', 256, '');
  301.                                 CloseResFile(fileRef);
  302.                                 CodeErr := SetVol(nil, aVol);
  303.                             end;
  304.                     end;
  305.             end
  306.         else
  307.             begin
  308.                 CodeErr := $0C0C;
  309.                 theCount := 1;
  310.                 CodeErr := FSWrite(fileRef, theCount, @CodeErr);
  311.             end;
  312.     end;
  313.  
  314. { And now we begin the real down to earth job starting with… }
  315.  
  316. procedure DraftPrText(byteCount: Integer; textBuf: Ptr; numer, denom: Point);
  317. { in case of TEXT saving, we just write the incoming text and we insert an ASCII code 13 meaning }
  318. { Carriage Return afterwards }
  319. { in case of PICT saving, we just call DrawText but in the picture saving grafport, after modifying, }
  320. { if need be, some grafport fields with the scaling ratio chosen by the user in the options dialog }
  321. var
  322.     pPrPort: TPPrPort;
  323.     CodeErr: Integer;
  324.     theCount: Longint;
  325.     
  326.     begin
  327.         GetPort(GrafPtr(pPrPort));
  328.         with MyPrintPtr(pPrPort^.lGParam4)^ do if textOrPict then
  329.             begin
  330.                 theCount := byteCount;
  331.                 CodeErr := FSWrite(fileRef, theCount, textBuf);
  332.                 CodeErr := $0D0D;
  333.                 theCount := 1;
  334.                 CodeErr := FSWrite(fileRef, theCount, @CodeErr);
  335.             end
  336.         else
  337.             begin
  338.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  339.                 SetPort(OtherPort);
  340.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  341.                 DrawText(textBuf, 0, byteCount);
  342.                 SetPort(GrafPtr(pPrPort));
  343.                 GetNewPenLoc(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, pPrPort^.gPort.pnLoc);
  344.                 {to set the pen location correctly}
  345.             end;
  346.     end;
  347.  
  348. procedure DraftPrLine(newPt: Point);
  349. { in case of PICT saving, we just call LineTo but in the picture saving grafport, after modifying, }
  350. { if need be, some grafport fields with the scaling ratio chosen by the user in the options dialog }
  351. var
  352.     pPrPort: TPPrPort;
  353.  
  354.     begin
  355.         GetPort(GrafPtr(pPrPort));
  356.         with MyPrintPtr(pPrPort^.lGParam4)^ do if not textOrPict then
  357.             begin
  358.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  359.                 SetPort(OtherPort);
  360.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  361.                 ModifyScalePoint(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, newPt);
  362.                 LineTo(newPt.h, newPt.v);
  363.                 SetPort(GrafPtr(pPrPort));
  364.                 GrafPtr(pPrPort)^.pnLoc := newPt; {to set the pen location correctly}
  365.             end;
  366.     end;
  367.  
  368. procedure DraftPrRect(verb: GrafVerb; r: Rect);
  369. { in case of PICT saving, we just call the right “Rect” trap depending on the verb }
  370. { but in the picture saving grafport, after modifying, if need be, }
  371. { some grafport fields with the scaling ratio chosen by the user in the options dialog }
  372. var
  373.     pPrPort: TPPrPort;
  374.  
  375.     begin
  376.         GetPort(GrafPtr(pPrPort));
  377.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  378.             begin
  379.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  380.                 SetPort(OtherPort);
  381.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  382.                 ModifyScaleRect(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, r);
  383.                 case verb of
  384.                     frame:    FrameRect(r);
  385.                     paint:    PaintRect(r);
  386.                     erase:    EraseRect(r);
  387.                     invert:    InvertRect(r);
  388.                     fill:        FillRect(r, fillPat);
  389.                 end;
  390.                 SetPort(GrafPtr(pPrPort));
  391.             end;
  392.     end;
  393.  
  394. procedure DraftPrrRect(verb: GrafVerb; r: Rect; ovalWidth, ovalHeight: Integer);
  395. { in case of PICT saving, we just call the right “rRect” trap depending on the verb }
  396. { but in the picture saving grafport, after modifying, if need be, }
  397. { some grafport fields with the scaling ratio chosen by the user in the options dialog }
  398. var
  399.     pPrPort: TPPrPort;
  400.  
  401.     begin
  402.         GetPort(GrafPtr(pPrPort));
  403.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  404.             begin
  405.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  406.                 SetPort(OtherPort);
  407.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  408.                 ModifyScaleRect(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, r);
  409.                 ModifyScalerRect(scaleRatio, ovalWidth, ovalHeight);
  410.                 case verb of
  411.                     frame:    FrameRoundRect(r, ovalWidth, ovalHeight);
  412.                     paint:    PaintRoundRect(r, ovalWidth, ovalHeight);
  413.                     erase:    EraseRoundRect(r, ovalWidth, ovalHeight);
  414.                     invert:    InvertRoundRect(r, ovalWidth, ovalHeight);
  415.                     fill:        FillRoundRect(r, ovalWidth, ovalHeight, fillPat);
  416.                 end;
  417.                 SetPort(GrafPtr(pPrPort));
  418.             end;
  419.     end;
  420.  
  421. procedure DraftPrOval(verb: GrafVerb; r: Rect);
  422. { in case of PICT saving, we just call the right “Oval” trap depending on the verb }
  423. { but in the picture saving grafport, after modifying, if need be, }
  424. { some grafport fields with the scaling ratio chosen by the user in the options dialog }
  425. var
  426.     pPrPort: TPPrPort;
  427.  
  428.     begin
  429.         GetPort(GrafPtr(pPrPort));
  430.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  431.             begin
  432.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  433.                 SetPort(OtherPort);
  434.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  435.                 ModifyScaleRect(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, r);
  436.                 case verb of
  437.                     frame:    FrameOval(r);
  438.                     paint:    PaintOval(r);
  439.                     erase:    EraseOval(r);
  440.                     invert:    InvertOval(r);
  441.                     fill:        FillOval(r, fillPat);
  442.                 end;
  443.                 SetPort(GrafPtr(pPrPort));
  444.             end;
  445.     end;
  446.  
  447. procedure DraftPrArc(verb: GrafVerb; r: Rect; startAngle, arcAngle: Integer);
  448. { in case of PICT saving, we just call the right “Arc” trap depending on the verb }
  449. { but in the picture saving grafport, after modifying, if need be, }
  450. { some grafport fields with the scaling ratio chosen by the user in the options dialog }
  451. var
  452.     pPrPort: TPPrPort;
  453.  
  454.     begin
  455.         GetPort(GrafPtr(pPrPort));
  456.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  457.             begin
  458.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  459.                 SetPort(OtherPort);
  460.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  461.                 ModifyScaleRect(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, r);
  462.                 case verb of
  463.                     frame:    FrameArc(r, startAngle, arcAngle);
  464.                     paint:    PaintArc(r, startAngle, arcAngle);
  465.                     erase:    EraseArc(r, startAngle, arcAngle);
  466.                     invert:    InvertArc(r, startAngle, arcAngle);
  467.                     fill:        FillArc(r, startAngle, arcAngle, fillPat);
  468.                 end;
  469.                 SetPort(GrafPtr(pPrPort));
  470.             end;
  471.     end;
  472.  
  473. procedure DraftPrPoly(verb: GrafVerb; Poly: PolyHandle);
  474. { in case of PICT saving, we just call the right “Poly” trap depending on the verb }
  475. { but in the picture saving grafport, after modifying, if need be, some grafport fields }
  476. { and the Poly itself with the scaling ratio chosen by the user in the options dialog }
  477. var
  478.     pPrPort: TPPrPort;
  479.  
  480.     begin
  481.         GetPort(GrafPtr(pPrPort));
  482.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  483.             begin
  484.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  485.                 SetPort(OtherPort);
  486.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  487.                 ModifyScalePoly(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, Poly);
  488.                 case verb of
  489.                     frame:    FramePoly(Poly);
  490.                     paint:    PaintPoly(Poly);
  491.                     erase:    ErasePoly(Poly);
  492.                     invert:    InvertPoly(Poly);
  493.                     fill:        FillPoly(Poly, fillPat);
  494.                 end;
  495.                 SetPort(GrafPtr(pPrPort));
  496.             end;
  497.     end;
  498.  
  499. procedure DraftPrRgn(verb: GrafVerb; Rgn: RgnHandle);
  500. { in case of PICT saving, we just call the right “Rgn” trap depending on the verb }
  501. { but in the picture saving grafport, after modifying, if need be, some grafport fields }
  502. { and the Rgn itself with the scaling ratio chosen by the user in the options dialog }
  503. var
  504.     pPrPort: TPPrPort;
  505.  
  506.     begin
  507.         GetPort(GrafPtr(pPrPort));
  508.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  509.             begin
  510.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  511.                 SetPort(OtherPort);
  512.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  513.                 ModifyScaleRgn(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, Rgn);
  514.                 case verb of
  515.                     frame:    FrameRgn(Rgn);
  516.                     paint:    PaintRgn(Rgn);
  517.                     erase:    EraseRgn(Rgn);
  518.                     invert:    InvertRgn(Rgn);
  519.                     fill:        FillRgn(Rgn, fillPat);
  520.                 end;
  521.                 SetPort(GrafPtr(pPrPort));
  522.             end;
  523.     end;
  524.  
  525. procedure DraftPrBits(var srcBits: BitMap; var srcRect, dstRect: Rect; mode: Integer; maskRgn: RgnHandle);
  526. { in case of PICT saving, we just call CopyBits but in the picture saving grafport, after modifying, }
  527. { if need be, some grafport fields with the scaling ratio chosen by the user in the options dialog }
  528. var
  529.     pPrPort: TPPrPort;
  530.     aRect: Rect;
  531.  
  532. aStr: Str255;
  533.  
  534.     begin
  535.         GetPort(GrafPtr(pPrPort));
  536.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  537.             begin
  538.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  539.                 SetPort(OtherPort);
  540.                 ModifyScalePort(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft);
  541.                 aRect := dstRect;
  542.                 ModifyScaleRect(OtherPort, scaleRatio, pPrPort^.gPort.portRect.topLeft, aRect);
  543.                 CopyBits(srcBits, portBits, srcRect, aRect, mode, maskRgn);
  544.                 SetPort(GrafPtr(pPrPort));
  545.             end;
  546.     end;
  547.  
  548. procedure DraftPrComment(kind, dataSize: Integer; dataHandle: Handle);
  549. { in case of PICT saving, we just call PicComment but in the picture saving grafport, }
  550. { and only if the user chose to save the PicComments in the options dialog }
  551. { Beware: some software do weird things with PicComments and with those, the PICT file is }
  552. { “correct” only if the user disable the PicComment saving }
  553. var
  554.     pPrPort: TPPrPort;
  555.  
  556.     begin
  557.         GetPort(GrafPtr(pPrPort));
  558.         with MyPrintPtr(pPrPort^.lGParam4)^, OtherPort^ do if not textOrPict then
  559.             begin
  560.                 BlockMove(Ptr(pPrPort), Ptr(OtherPort), sizeof(GrafPort)-16);
  561.                 SetPort(OtherPort);
  562.                 PicComment(kind, dataSize, dataHandle);
  563.                 SetPort(GrafPtr(pPrPort));
  564.             end;
  565.     end;
  566.  
  567. { That's all for the down to earth job ! }
  568.  
  569. procedure ChangeBottleNeck(withColor: Boolean; myPPrPort: TPPrPort; thePrintPtr: MyPrintPtr; withPicComments: Boolean);
  570. { here we actually replace the standard QuickDraw bottleneck routines by ours }
  571.     procedure SetPrgProcs;
  572.         begin
  573.             myPPrPort^.gProcs.textProc := @DraftPrText;
  574.             myPPrPort^.gProcs.lineProc := @DraftPrLine;
  575.             myPPrPort^.gProcs.rectProc := @DraftPrRect;
  576.             myPPrPort^.gProcs.rRectProc := @DraftPrrRect;
  577.             myPPrPort^.gProcs.ovalProc := @DraftPrOval;
  578.             myPPrPort^.gProcs.arcProc := @DraftPrArc;
  579.             myPPrPort^.gProcs.polyProc := @DraftPrPoly;
  580.             myPPrPort^.gProcs.rgnProc := @DraftPrRgn;
  581.             myPPrPort^.gProcs.bitsProc := @DraftPrBits;
  582.             if withPicComments then myPPrPort^.gProcs.commentProc := @DraftPrComment;
  583.         end;
  584.     begin
  585.         with thePrintPtr^ do if withColor then
  586.             begin
  587.                 OpenCPort(CGrafPtr(myPPrPort));
  588.                 SetStdCProcs(cProcs);
  589.                 
  590.                 { even with a Color PICT saving, we set the gProcs field of the Printing port }
  591.                 { just in case some weird application wants to use them directly }
  592.                 { to my knowledge, no application do such an absurd thing as that but Murphy Lives ! }
  593.                 SetPrgProcs;
  594.                 
  595.                 cProcs.textProc := @DraftPrText;
  596.                 cProcs.lineProc := @DraftPrLine;
  597.                 cProcs.rectProc := @DraftPrRect;
  598.                 cProcs.rRectProc := @DraftPrrRect;
  599.                 cProcs.ovalProc := @DraftPrOval;
  600.                 cProcs.arcProc := @DraftPrArc;
  601.                 cProcs.polyProc := @DraftPrPoly;
  602.                 cProcs.rgnProc := @DraftPrRgn;
  603.                 cProcs.bitsProc := @DraftPrBits;
  604.                 if withPicComments then cProcs.commentProc := @DraftPrComment;
  605.                 CGrafPtr(MyPPrPort)^.grafProcs := @cProcs;
  606.             end
  607.         else
  608.             begin
  609.                 OpenPort(GrafPtr(myPPrPort));
  610.                 SetStdProcs(myPPrPort^.gProcs);
  611.                 SetPrgProcs;
  612.                 myPPrPort^.gPort.grafProcs := @myPPrPort^.gProcs;
  613.             end;
  614.     end;
  615.  
  616. function GetValues(hPrint: THPrint; thePrintPtr: MyPrintPtr): Boolean;
  617. { let's transfer some values from resources or hPrint to my sapce work for commodity }
  618. var
  619.     aStrHdl: StringHandle;
  620.     
  621.     begin
  622.         GetValues := true;
  623.         aStrHdl := GetString(-8191);
  624.         if aStrHdl = nil then
  625.             begin
  626.                 GetValues := false;
  627.                 exit(GetValues);
  628.             end;
  629.         thePrintPtr^.fileName := aStrHdl^^;
  630.         with thePrintPtr^ do
  631.             begin
  632.                 BlockMove(@hPrint^^.printX[10], @theTextType, 4);
  633.                 BlockMove(@hPrint^^.printX[12], @thePictType, 4);
  634.                 BlockMove(@hPrint^^.printX[15], @scaleRatio, 4);
  635.                 textOrPict := (hPrint^^.printX[8] = 0);
  636.             end;
  637.     end;
  638.  
  639. function GetVolumeRef(theWDRefNum: Integer; VAR theVolRef: Integer; VAR theDirID: Longint): OsErr;
  640. { 'nuff said ! }
  641. var
  642.     theWDBlock: WDPBRec;
  643.     aStr: Str255;
  644.  
  645.     begin
  646.         with theWDBlock do
  647.             begin
  648.                 ioCompletion := nil;
  649.                 ioNamePtr := @aStr;
  650.                 ioVRefNum := theWDRefNum;
  651.                 ioWDIndex := 0;
  652.                 ioWDProcID := 0;
  653.                 ioWDVRefNum := 0;
  654.                 GetVolumeRef := PBGetWDInfo(@theWDBlock, false);
  655.                 theVolRef := ioWDVRefNum;
  656.                 theDirID := theWDBlock.ioWDDirID;
  657.             end;
  658.     end;
  659.  
  660. function CreateDirectory(VAR fName: Str63; theVRefNum: Integer; theDirID: Longint; VAR theNewDirID: Longint): OsErr;
  661. { 'nuff saif ! }
  662. var
  663.     theHBlock: HParamBlockRec;
  664.  
  665.     begin
  666.         with theHBlock do
  667.             begin
  668.                 ioCompletion := nil;
  669.                 ioNamePtr := @fName;
  670.                 ioVRefNum := theVRefNum;
  671.                 ioDirID := theDirID;
  672.                 CreateDirectory := PBDirCreate(@theHBlock, false);
  673.                 theNewDirID := theHBlock.ioDirID;
  674.             end;
  675.     end;
  676.  
  677. function OpenWorkingDirectory(theVolRef: Integer; theDirID: Longint; VAR theWDRefNum: Integer): OsErr;
  678. { 'nuff said ! }
  679. var
  680.     theWDBlock: WDPBRec;
  681.  
  682.     begin
  683.         with theWDBlock do
  684.             begin
  685.                 ioCompletion := nil;
  686.                 ioNamePtr := nil;
  687.                 ioVRefNum := theVolRef;
  688.                 ioWDProcID := 0;
  689.                 ioWDDirID := theDirID;
  690.                 OpenWorkingDirectory := PBOpenWD(@theWDBlock, false);
  691.                 theWDRefNum := theWDBlock.ioVRefNum;
  692.             end;
  693.     end;
  694.  
  695. function AskUser(thePrintPtr: MyPrintPtr): OsErr;
  696. { always ask user (heh ! heh ! heh !) }
  697. { in case of TEXT saving, we just create a TEXT file with the name chosen }
  698. { in case of PICT saving, we just create a folder with the name chosen and we open that directory }
  699.  
  700. { • New ! v.1.1 • if the requested PICT creator is 'RSED' (ResEdit), we create a resource file }
  701. {                 in which we will store the pictures as PICT resources }
  702. var
  703.     thePoint: Point;
  704.     theReply: SFReply;
  705.     CodeErr: OsErr;
  706.     theDirID: Longint;
  707.     theVolRef: Integer;
  708.     
  709.     procedure BugOut;
  710.         begin AskUser := CodeErr; exit(AskUser); end;
  711.  
  712.     begin
  713.         AskUser := noErr;
  714.         with thePrintPtr^, theReply do
  715.             begin
  716.                 thePoint.h := 50; thePoint.v := 50;
  717.                 SFPutFile(thePoint, '', fileName, nil, theReply);
  718.                 if good then
  719.                     begin
  720.                         if textOrPict or (thePictType = 'RSED') then            { • New ! v.1.1 • }
  721.                             begin
  722.                                 CodeErr := FSDelete(fName, vRefNum);
  723.                                 if textOrPict                                            { • New ! v.1.1 • }
  724.                                     then CodeErr := Create(fName, vRefNum, theTextType, 'TEXT')
  725.                                     else CodeErr := Create(fName, vRefNum, 'RSED', 'rsrc');
  726.                                 if CodeErr <> noErr then BugOut;
  727.                                 if textOrPict then                                    { • New ! v.1.1 • }
  728.                                     CodeErr := FSOpen(fName, vRefNum, fileRef)
  729.                                 else
  730.                                     begin
  731.                                         CodeErr := SetVol(nil, vRefNum);
  732.                                         CreateResFile(fName);
  733.                                         fileRef := OpenResFile(fName);
  734.                                         if fileRef = -1 then CodeErr := ResError;
  735.                                         CurPage := 0;
  736.                                     end;
  737.                                 if CodeErr <> noErr then BugOut;
  738.                                 dirVol := vRefNum;
  739.                             end
  740.                         else
  741.                             begin
  742.                                 CodeErr := GetVolumeRef(vRefNum, theVolRef, theDirID);
  743.                                 if CodeErr <> noErr then BugOut;
  744.                                 CodeErr := CreateDirectory(fName, vRefNum, theDirID, dirID);
  745.                                 if CodeErr <> noErr then BugOut;
  746.                                 CodeErr := OpenWorkingDirectory(theVolRef, dirID, dirVol);
  747.                                 if CodeErr <> noErr then BugOut;
  748.                                 dirName := fName;
  749.                                 CurPage := 0;
  750.                             end;
  751.                         fileName := fName;
  752.                     end
  753.                 else AskUser := iPrAbort;
  754.             end;
  755.     end;
  756.  
  757. function AdjustToInteger(theLong: Longint): Integer;
  758. { let's trunc the Longint to an Integer }
  759.     begin
  760.         if theLong > 32767 then AdjustToInteger := 32767
  761.         else if theLong < $FFFF8000 then AdjustToInteger := $8000
  762.         else AdjustToInteger := theLong;
  763.     end;
  764.  
  765. procedure ModifyScalePort(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point);
  766. { apply the scaling ratio to the right fields of the grafport }
  767. var
  768.     aRect: Rect;
  769.  
  770.     begin
  771.         with OtherPort^, portRect, topLeft do
  772.             begin
  773.                 top := AdjustToInteger((scaleRatio * top) div 100);
  774.                 left := AdjustToInteger((scaleRatio * left) div 100);
  775.                 bottom := AdjustToInteger((scaleRatio * bottom) div 100);
  776.                 right := AdjustToInteger((scaleRatio * right) div 100);
  777.                 SetRect(aRect, -32767, -32767, 32767, 32767);
  778.                 RectRgn(visRgn, aRect);
  779.                 RectRgn(clipRgn, aRect);
  780.                 pnLoc.h := AdjustToInteger((scaleRatio * (pnLoc.h - h)) div 100 + left);
  781.                 pnLoc.v := AdjustToInteger((scaleRatio * (pnLoc.v - v)) div 100 + top);
  782.                 pnSize.h := AdjustToInteger((scaleRatio * pnSize.h) div 100);
  783.                 pnSize.v := AdjustToInteger((scaleRatio * pnSize.v) div 100);
  784.                 txSize := AdjustToInteger((scaleRatio * txSize) div 100);
  785.             end;
  786.     end;
  787.  
  788. procedure ModifyScalePoint(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR thePoint: Point);
  789.     begin
  790.         with OtherPort^.portRect, topLeft do
  791.             begin
  792.                 thePoint.h := AdjustToInteger((scaleRatio * (thePoint.h - h)) div 100 + left);
  793.                 thePoint.v := AdjustToInteger((scaleRatio * (thePoint.v - v)) div 100 + top);
  794.             end;
  795.     end;
  796.  
  797. procedure GetNewPenLoc(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR thePoint: Point);
  798.     begin
  799.         with OtherPort^, portRect, topLeft do
  800.             begin
  801.                 thePoint.h := AdjustToInteger((Longint(100) * (pnLoc.h - left)) div scaleRatio + h);
  802.                 thePoint.v := AdjustToInteger((Longint(100) * (pnLoc.v - top)) div scaleRatio + v);
  803.             end;
  804.     end;
  805.  
  806. procedure ModifyScaleRect(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR theRect: Rect);
  807.     begin
  808.         with OtherPort^.portRect, topLeft do
  809.             begin
  810.                 theRect.top := AdjustToInteger((scaleRatio * (theRect.top - v)) div 100 + top);
  811.                 theRect.left := AdjustToInteger((scaleRatio * (theRect.left - h)) div 100 + left);
  812.                 theRect.bottom := AdjustToInteger((scaleRatio * (theRect.bottom - v)) div 100 + top);
  813.                 theRect.right := AdjustToInteger((scaleRatio * (theRect.right - h)) div 100 + left);
  814.             end;
  815.     end;
  816.  
  817. procedure ModifyScalerRect(scaleRatio: Longint; VAR ovalWidth, ovalHeight: Integer);
  818.     begin
  819.         ovalWidth := AdjustToInteger((scaleRatio * ovalWidth) div 100);
  820.         ovalHeight := AdjustToInteger((scaleRatio * ovalHeight) div 100);
  821.     end;
  822.  
  823. procedure ModifyScalePoly(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR thePoly: PolyHandle);
  824. var
  825.     theLength, pos: Longint;
  826.     aPoint: Point;
  827.  
  828.     begin
  829.         with OtherPort^.portRect, topLeft, thePoly^^ do
  830.             begin
  831.                 ModifyScaleRect(OtherPort, scaleRatio, topLeft, polyBBox);
  832.                 theLength := GetHandleSize(Handle(thePoly));
  833.                 pos := 10;
  834.                 while pos < theLength do
  835.                     begin
  836.                         BlockMove(Ptr(Longint(thePoly^)+pos), @aPoint, 4);
  837.                         ModifyScalePoint(OtherPort, scaleRatio, topLeft, aPoint);
  838.                         BlockMove(@aPoint, Ptr(Longint(thePoly^)+pos), 4);
  839.                         pos := pos+4;
  840.                     end;
  841.             end;
  842.     end;
  843.  
  844. procedure ModifyScaleRgn(OtherPort: GrafPtr; scaleRatio: Longint; topLeft: Point; VAR theRgn: RgnHandle);
  845. var
  846.     theLength: Longint;
  847.     aHandle: Handle;
  848.     dh, dv, delh, delv: Integer;
  849.     aPoint: Point;
  850.  
  851.     begin
  852.         theLength := GetHandleSize(Handle(theRgn));
  853.         aHandle := NewHandle(2 * theLength);    {cf IM I-184 for explanation}
  854.         if aHandle <> nil then
  855.             begin
  856.                 DisposHandle(aHandle);
  857.                 aPoint := theRgn^^.rgnBBox.topLeft;
  858.                 ModifyScalePoint(OtherPort, scaleRatio, topLeft, aPoint);
  859.                 dh := aPoint.h - theRgn^^.rgnBBox.left;
  860.                 dv := aPoint.v - theRgn^^.rgnBBox.top;
  861.                 OffsetRgn(theRgn, dh, dv);
  862.                 
  863.                 dh := theRgn^^.rgnBBox.right - theRgn^^.rgnBBox.left;
  864.                 dv := theRgn^^.rgnBBox.bottom - theRgn^^.rgnBBox.top;
  865.                 delh := AdjustToInteger((scaleRatio * dh) div 100);
  866.                 delv := AdjustToInteger((scaleRatio * dv) div 100);
  867.                 InsetRgn(theRgn, dh-delh, dv-delv);
  868.                 OffsetRgn(theRgn, (delh - dh) div 2, (delv -dv) div 2);
  869.             end;
  870.     end;
  871.  
  872. end.
  873.